home *** CD-ROM | disk | FTP | other *** search
Text File | 1997-11-28 | 1.5 KB | 67 lines | [TEXT/ALFA] |
- ## -*-Tcl-*- (install)
- # ###################################################################
- #
- # FILE: "macros.tcl"
- # created: 27/7/97 {11:39:46 pm}
- # last update: 28/11/97 {5:33:40 pm}
- # ###################################################################
- ##
- alpha::extension macros 0.2.1 {
- menu::buildProc KbdMacros rebuildMacroMenu
- menu::insert Utils submenu end KbdMacros
- } disable {
- menu::uninsert Utils submenu end KbdMacros
- }
-
-
- proc dumpNamedMacro {} {
- global macroArr
- set name [listpick -p "Macro name?" [array names macroArr]]
- regsub -all ";\r" $macroArr($name) "\r" text
- insertText $text
- }
-
- proc nameLastMacro {} {
- global macroArr modifiedArrVars
- set name [prompt "Macro name?" ""]
- regsub macroName [keyboardMacro] $name macro
- regsub -all "\r" $macro ";\r" macro
- eval $macro
- set macroArr($name) $macro
- lappend modifiedArrVars macroArr
- rebuildMacroMenu
- }
-
- proc deleteNamedMacro {} {
- global macroArr modifiedArrVars
-
- set which [listpick -p "Delete which macro?" [lsort [array names macroArr]]]
- unset macroArr($which)
- lappend modifiedArrVars macroArr
- rebuildMacroMenu
- }
-
- proc rebuildMacroMenu {} {
- menu -n KbdMacros {
- "/qstartKeyboardMacro"
- "/rendKeyboardMacro"
- "/sexecuteKeyboardMacro"
- "(-"
- "nameLastMacro"
- "deleteNamedMacro"
- "dumpNamedMacro"
- "(-"
- "menu -n macros {}"
- }
- global macroArr
-
- set l {}
- foreach f [lsort [array names macroArr]] {
- eval $macroArr($f)
- lappend l $f
- }
- eval menu -m -n macros [list $l]
- }
-
-
-